﻿Imports System.Xml
Imports System.Text
''' <summary>
''' 将各种数据转为COBOL
''' </summary>
''' <remarks></remarks>
Public Class clsDataConverter
#Region "变量"
    ''' <summary>
    ''' 注释行
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared CommentList As List(Of String)
    ''' <summary>
    ''' 层号和变量名称
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared HeadString As String
    ''' <summary>
    ''' 初始值行
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared InitList As List(Of String)
    ''' <summary>
    ''' PIC描述行
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared PICList As List(Of String)
    ''' <summary>
    ''' 重复次数
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared strOccurs As String
    ''' <summary>
    ''' DEF
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared strDef As String
    ''' <summary>
    ''' BASED
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared StrBased As String
#End Region
#Region "过程和函数"
    ''' <summary>
    ''' 初始化
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared Sub Initalize()
        CommentList = New List(Of String)
        HeadString = String.Empty
        InitList = New List(Of String)
        PICList = New List(Of String)
        strOccurs = String.Empty
        strDef = String.Empty
        StrBased = String.Empty
    End Sub
    ''' <summary>
    ''' 获得各种情报数据部
    ''' </summary>
    ''' <param name="mData"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function GetDataDefine(ByVal mData As XmlElement) As List(Of String)
        Dim strRtn As New List(Of String)
        Initalize()
        '获得层号和名字
        Select Case mData.GetAttribute("LayNo")
            Case "COPY"
                'COPY句
                strRtn.Add(Space(LeftStart + 2) & "COPY  " & clsJustifyStatement.LastModifyVarName(mData.GetAttribute("COPYBOOKNAME").Replace(";", String.Empty)) & ".")
                Return strRtn
            Case String.Empty
                '单行或者是INCLUDE
                Select Case mData.Name
                    Case "SINGLEDATA"
                        HeadString = Space(LeftStart) & "01" & Space(2) & clsJustifyStatement.LastModifyVarName(mData.GetAttribute("NAME"))
                    Case "INCLUDE"
                        If mData.GetAttribute("FirstLayNo") = String.Empty Then
                            strRtn.Add(Space(LeftStart) & "COPY" & Space(2) & clsJustifyStatement.LastModifyVarName(mData.GetAttribute("COPYBOOKNAME")) & ".")
                        Else
                            strRtn.Add(Space(LeftStart + (CInt(mData.GetAttribute("FirstLayNo")) - 1) * 2) & "COPY" & Space(2) & clsJustifyStatement.LastModifyVarName(mData.GetAttribute("COPYBOOKNAME")) & ".")
                        End If
                        Return strRtn
                End Select
            Case Else
                '其他Tree数据
                HeadString = Space(LeftStart + (CInt(mData.GetAttribute("LayNo")) - 1) * 2)
                HeadString = HeadString & Format(CInt(mData.GetAttribute("LayNo")), "0#") & Space(2)
                HeadString = HeadString & clsJustifyStatement.LastModifyVarName(mData.GetAttribute("NAME"))
        End Select
        '获得初始值列表
        If mData.GetAttribute("INIT") <> String.Empty Then InitList = GetInit(mData)
        '获得注释列表
        If mData.GetAttribute("COMMENT") <> String.Empty Then CommentList = GetComment(mData)
        '获得PIC列表
        PICList = ClsDataObject.GetPicDescrptionByXmlElement(mData)
        '获得重复次数
        If Not (mData.GetAttribute("REPEAT") = "1" Or mData.GetAttribute("REPEAT") = "") Then
            strOccurs = "OCCURS" & Space(2) & mData.GetAttribute("REPEAT") & Space(2) & "TIMES"
        End If
        '对REDEFINES进行排版
        If mData.GetAttribute("DEF") <> String.Empty Then
            strDef = "REDEFINES  " & mData.GetAttribute("DEF")
        End If
        'BASED处理
        StrBased = GetBased(mData)
        '将上面获得的各种数据整合为行
        SetDataString(strRtn)
        Return strRtn
    End Function
    ''' <summary>
    ''' 组织数据字符
    ''' </summary>
    ''' <remarks></remarks>
    Public Shared Sub SetDataString(ByVal DataStringList As List(Of String))
        '临时行
        Dim SingleLine As String = String.Empty

        '1)注释行
        If CommentList.Count > 0 Then
            For Each strLine As String In CommentList
                DataStringList.Add(Space(LeftStart - 1) & strLine)
            Next
        End If

        '2)层号,数据名称
        SingleLine = HeadString
        '重复次数
        If strOccurs <> String.Empty Then SingleLine &= Space(2) & strOccurs
        'REDIFINES
        If strDef <> String.Empty Then SingleLine &= Space(2) & strDef
        'REDIFINES
        If StrBased <> String.Empty Then SingleLine &= Space(2) & StrBased

        If Not PICList Is Nothing Then
            '3)PIC可能种类
            'A.单行
            'B.2行 发生无法转换的情况,第一行 以 *ERROR: 开始
            'C.2行 附有 COMP,DISP 属性的情况
            If PICList.Count = 1 Then
                'A.单行
                SingleLine = SetEndSpace(SingleLine, PICPosition) & PICList(0)
            Else
                If PICList(0).StartsWith("*ERROR:") Then
                    'B.2行 发生无法转换的情况,第一行 以 *ERROR: 开始
                    DataStringList.Add(Space(LeftStart - 1) & PICList(0))
                    SingleLine = SetEndSpace(SingleLine, PICPosition) & PICList(1)
                Else
                    'C.2行 附有 COMP,DISP 属性的情况
                    SingleLine = SetEndSpace(SingleLine, PICPosition) & PICList(0)
                    If PICList(1).Length + 2 < RightEnd Then
                        SingleLine &= Space(2) & PICList(1)
                    Else
                        DataStringList.Add(SingleLine)
                        SingleLine = Space(LeftStart) & PICList(1)
                    End If
                End If
            End If
        End If
        'INIT放在最后
        If InitList.Count = 1 Then
            'VALUE 位置确定
            If SingleLine.Length + 2 + ("VALUE").Length < RightEnd Then
                SingleLine = SetEndSpace(SingleLine & Space(2) & "VALUE", VALUEPosition)
            Else
                DataStringList.Add(SingleLine)
                SingleLine = Space(LeftStart + 4) & "VALUE" & Space(2)
            End If
            Dim strInit As String = InitList(0).Trim
            If Text.Encoding.GetEncoding(932).GetByteCount(SingleLine & strInit) > RightEnd Then
                DataStringList.Add(SingleLine)
                If Text.Encoding.GetEncoding(932).GetByteCount(strInit) < 30 Then
                    DataStringList.Add(Space(PICPosition) & strInit)
                Else
                    DataStringList.Add(Space(LeftStart + 4) & strInit)
                End If
            Else
                DataStringList.Add(SingleLine & strInit)
            End If
        Else
            DataStringList.Add(SingleLine)
        End If
        DataStringList(DataStringList.Count - 1) = _
        DataStringList(DataStringList.Count - 1).TrimEnd & "."
    End Sub
    ''' <summary>
    ''' 获取注释行
    ''' </summary>
    ''' <param name="mData"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function GetComment(ByVal mData As XmlElement) As List(Of String)
        Dim strRtn As New List(Of String)
        Dim Commentlist As List(Of String) = GetCommentArray(mData.GetAttribute("COMMENT"))
        For t As Byte = 0 To Commentlist.Count - 1
            strRtn.Add("*" & Mid(Commentlist(t), 3, Commentlist(t).Length - 4) & "*")
        Next
        Return strRtn
    End Function
    ''' <summary>
    ''' 获取INIT行
    ''' </summary>
    ''' <param name="mData"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function GetInit(ByVal mData As XmlElement) As List(Of String)
        Dim strRtn As New List(Of String)
        Dim InitValue As String = mData.GetAttribute("INIT")
        '对于BIT的处理 VALUE X'0E'
        If mData.GetAttribute("TYPE") = "BIT" AndAlso mData.GetAttribute("LENGTH") = "8" Then
            If InitValue <> String.Empty Then
                InitValue = Mid(InitValue, 2, 8)
                Dim strHex As String = Hex(Convert.ToInt32(InitValue, 2))
                If strHex.Length = 1 Then strHex = "0" & strHex
                strRtn.Add("X'" & strHex & "'")
                Return strRtn
            End If
        End If
        '对于CHAR(80) INIT (80)*的处理 VALUE ALL ‘*’
        If mData.GetAttribute("TYPE") = "CHAR" Then
            If clsJustifyData.GetInitRepeat(InitValue) = mData.GetAttribute("LENGTH") Then
                strRtn.Add("ALL  '" & clsJustifyData.GetInitValue(InitValue) & "'")
                Return strRtn
            End If
        End If
        If mData.GetAttribute("TYPE") = "BIT" Then
            '对于原来是BIT的项目，初始值去掉尾部的B
            If InitValue.EndsWith("'B") Then
                InitValue = Mid(InitValue, 1, InitValue.Length - 1)
                If InitValue.Trim = "0" Or InitValue.Trim = "'0'" Then
                    strRtn.Add("ZERO")
                Else
                    strRtn.Add(InitValue)
                End If
                Return strRtn
            End If
        End If
        If InitValue.Trim = "(" & mData.GetAttribute("LENGTH") & ")' '" Then
            strRtn.Add("SPACES")
            Return strRtn
        End If
        If InitValue.StartsWith("'") And InitValue.EndsWith("'") Then
            If Mid(InitValue, 2, InitValue.Length - 2).Trim = String.Empty Then
                If mData.GetAttribute("LENGTH") = "1" Then
                    strRtn.Add("SPACE")
                Else
                    strRtn.Add("SPACES")
                End If
                Return strRtn
            End If
        End If
        If InitValue.Trim = "(" & mData.GetAttribute("LENGTH") & ")'0'" Then
            strRtn.Add("ZEROS")
            Return strRtn
        End If
        If InitValue.Trim = "0" Or InitValue.Trim = "'0'" Then
            strRtn.Add("ZERO")
            Return strRtn
        End If
        strRtn.Add(InitValue)
        Return strRtn
    End Function
    ''' <summary>
    ''' BASED处理
    ''' </summary>
    ''' <param name="mData"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function GetBased(ByVal mData As XmlElement) As String
        If mData.GetAttribute("BASED") <> String.Empty Then
            Dim strBased As String = mData.GetAttribute("BASED")
            If strBased.StartsWith("ADDR(") Then
                strBased = Mid(strBased, 6, strBased.Length - 6).Trim
                'BASED经过调整后肯定是顶层
                Return "REDEFINES  " & clsJustifyStatement.LastModifyVarName(strBased)
            End If
        End If
        Return String.Empty
    End Function
    ''' <summary>
    ''' 在字符尾部添加空格，使字符达到定长
    ''' </summary>
    ''' <param name="orgString">字符</param>
    ''' <param name="iLength">希望长度</param>
    ''' <returns></returns>
    ''' <remarks>如果字符原本就超过定长，则在后面直接添加空格</remarks>
    Public Shared Function SetEndSpace(ByVal orgString As String, ByVal iLength As Byte) As String
        Dim rtnString As String = String.Empty
        If orgString.Length >= iLength Then
            rtnString = orgString & Space(Indent)
        Else
            rtnString = Mid(orgString & Space(iLength), 1, iLength)
        End If
        Return rtnString
    End Function
#End Region
End Class